perm filename PT2.OLD[MSS,LCS]1 blob
sn#179207 filedate 1975-09-26 generic text, type T, neo UTF8
00010 DATA QLINE/150.0/,HX/2./,ZL/2./,ZM/-1.5/
00015 C QLINE=BASIC LINE LENGTH, HX=HEIGHT MULTIPLIER, ZL=LN. LNGTH FACTOR.
00020
00030 COMMON/XRN/RN(2000) /SF/KL,RT,KP,STFSZ,NAMX
00040 COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
00050 COMMON/STF/RSTFAC(-3/4),RSTJ2
00060 COMMON/POSI/STFF(-3/4),SIGQ,PQ/PTR/PWDS(250),L,LL,I,RXQ
00070 DIMENSION IV(78)
00080 EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
00090 1,(R8,RQ(6)),(R9,RQ(7)),(IV,PWDS)
00100 COMMON /PX/SX,PN(1800),Q(6000)
00200 CALL IFILE(1,'PX')
00220 READ(1),L,LL,
00240 1(PN(N),N=1,L+1),(Q(N),N=1,LL-1),NAMX,STFSZ,J,J,RSTFAC,STFF,IV,STFF
00300 RSTJ2=STFSZ
00310 2000 I=L
00410 KK=1
00420 XLINE=QLINE
00430 ENDLN=Q(IFIX(PN(L))+3)
00760 TYPE 4,J
00770 4 FORMAT(I4,' LINES - OR TYPE NUM --',$)
00780 ACCEPT 5,RA
00790 5 FORMAT(F)
00792 IF(RA.NE.0)XLINE=ENDLN/(RA+ZL)
00793 ZLINE=XLINE
00795 RA=0
00800 CLEF=-99
00850 JSLUR=0
00900 SIG=CLEF
01100 100 KL=1
01300 KP=1
01600 RT=2
01800 J=KK
01900 HGT=HX*2.
01950
02000 DO 1 K=KK,I
02100 N=PN(K)
02200 IF(Q(N+1).NE.4)GO TO 1
02300 CC IF(Q(N).GT.2)GO TO 1
02400 IF(Q(N+3).LT.XLINE)GO TO 1
02500 C FOUND LAST BAR LINE.
02510 RX=0
02600 3 JJ=KP
02700 C PUTS IN STAFF
02705 RS=3.
02710 IF(RT.NE.0)GO TO 331
02720 C NEXT FOR BOTTOM STAFF. PUTS IN SPACER.
02730 RS=6.
02740 R8=2.45
02800 331 CALL STAFF(RS,8.,0,HGT,STFSZ,0,0,R8)
02820 HGT=HGT-HX
02900 IF(XLINE.EQ.ZLINE)GO TO 33
02910 IF(XLINE.LT.ENDLN)GO TO 6
02914 RX=RT
02916 RT=0
02918 CALL STAFF(6.,8.,0,0,0,0,1.,2.45)
02922 C PUTS IN SPACER
02925 RT=RX
02928 6 IF(JSLUR.EQ.0)GO TO 333
02930 CALL STAFF(5.,5.,0,Q(JSLUR),Q(JSLUR+1),11.,Q(JSLUR+3),0)
02940 JSLUR=0
03000 333 IF(CLEF.EQ.-99)GO TO 33
03100 C ONLY STAFF FOR FIRST LINE AT TOP.
03200 RX=10.*STFSZ
03300 C THE SPACER
03500 CALL STAFF(3.,3.,1.,0,CLEF,0,0,0)
03600 IF(SIG.EQ.-99)GO TO 33
03710 RS=3.
03720 R5=SIG
03730 RX=0
03740 IF(R5.LT.50)GO TO 332
03750 RX=IFIX((R5+50.)/100.)
03760 R5=R5-RX*100.
03770 RS=4.
03800 C CLEF+SIG
04000 332 CALL STAFF(RS,17.,11.0*STFSZ,0,R5,RX,0,0)
04010 RX=13.*STFSZ
04100
04200 33 R4=RA
04300 R5=Q(N+3)
04400 RS=3
04500 R7=RT
04600 R8=RX
04700 R9=200.
04800 LL=0
04900 L=K-J+1
05000 CALL PTMOVE(Q,PN(J))
05100 RA=R5
05200 KB=KL
05300 DO 30 NA=KK,K
05400 PWDS(KP)=KB
05500 KP=KP+1
05510 JK=PN(NA)
05520 R=Q(JK+1)
05530 IF(R.NE.5)GO TO 35
05540 IF(Q(JK+6).LT.199.)GO TO 30
05542 C CATCHES END OF SLUR
05545 Q(JK+6)=201.
05547 JSLUR=JK+4
05548 C TO PUT SLUR ON NEXT LINE.
05560 GO TO 30
05570 35 IF(R.NE.2)GO TO 36
05580 IF(Q(JK).LT.6.)GO TO 30
05590 CC RR=Q(IFIX(PN(NA-1))+3)
05592 RR=RIGHT(NA,-1)
05595 IF(RR.GE.199.)RR=RX
05600 CC Q(JK+3)=RR-1.6*STFSZ+(Q(IFIX(PN(NA+1))+3)-RR)/2.
05602 Q(JK+3)=RR-1.6*STFSZ+(RIGHT(NA,1)-RR)/2.
05603 C FUNCTION 'RIGHT' FINDS RIGHT ITEMS FOR CENTERING.
05605 C CENTERS WHOLE REST
05607 GO TO 30
05610 36 IF(R.NE.3)GO TO 34
05619 RR=Q(JK+5)
05628 IF(Q(JK).LT.3)RR=0
05637 CLEF=RR
05646 GO TO 30
05655 34 IF(R.NE.17)GO TO 37
05664 SIG=Q(JK+5)
05673 IF(Q(JK).GT.3)SIG=SIG+Q(JK+6)*100.
05682 C CLEF # IN P6 WITH KEY SIGS.
05710 C NEXT CHANGES CODE NUM BACK TO ORIGINAL
05730 37 IF(R.GE.33)Q(JK+1)=R/11.
05810 30 KB=PN(NA+1)-PN(NA)+KB
05820
05830 DO 31 NA=IFIX(PN(KK)),IFIX(PN(K+1)-1.)
05900 RN(KL)=Q(NA)
06000 31 KL=KL+1
06050 KK=K+1
06100 RS=RT
06200 LL='J'
06300 R4=0
06400 R5=200
06500 NA=L
06600 L=KP-JJ+1
06700 CALL PTMOVE(RN,PWDS(JJ))
06710 IF(K.EQ.I)GO TO 2
06800 L=NA
06900 J=K+1
07000 C SO IT DOESN'T GO THRU ALL DATA
07100 RT=RT-1
07200 XLINE=RA+ZLINE
07250 IF(ENDLN-XLINE.LT.80.)XLINE=ENDLN
07310 10 IF(KL.GT.1700.OR.KP.GT.190.OR.RT)GO TO 2
07400 1 IF(K.EQ.I)GO TO 3
07600 2 L=KP
07610 PWDS(KP+1)=KB
07670 J=1
07718 CALL OFILE(1,NAMX)
07766 LL=PWDS(L+1)
07770 2929 WRITE(1),L,LL,
07780 1(PWDS(N),N=1,L+1),(RN(N),N=1,LL-1),J,J,J,J,RSTFAC,STFF,IV,STFF
07785 TYPE 101,NAMX
07787 101 FORMAT(1XA5)
07790 IF(KK.GE.I)CALL EXIT
07800 NAMX=NAMX+2
07810 END FILE(1)
07820 GO TO 100
07910 END
07920
07930 SUBROUTINE STAFF(P0,P1, P3,P4,P5,P6,P7,P8)
08000 COMMON/XRN/RN(2000) /SF/KL,RT,KP,STFSZ,NAMX
08100 COMMON /PTR/PWDS(250),L,LL,I,IX
08200 PWDS(KP)=KL
08210 KP=KP+1
08300 RN(KL)=P0
08400 RN(KL+1)=P1
08500 RN(KL+2)=RT
08600 RN(KL+3)=P3
08700 RN(KL+4)=P4
08702 RN(KL+5)=P5
08810 IF(P0.LT.4.)GO TO 1
08820 RN(KL+6)=P6
08830 IF(P0.LT.5)GO TO 1
08832 RN(KL+7)=P7
08835 IF(P0.LT.6)GO TO 1
08840 RN(KL+8)=P8
08850 1 KL=KL+P0+3.
09000 END
09100
09150 FUNCTION RIGHT(NA,J)
09200 COMMON /PX/SX,PN(1800),Q(6000)
09300 K=NA+J
09350 C J IS EITHER +1 OR -1
09400 1 L=PN(K)
09500 IF(Q(L+1).NE.16)GO TO 2
09600 K=K+J
09700 GO TO 1
09800 2 RIGHT=Q(L+3)
09900 END